home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / Ant Movie Catalog 3.5.0.2 / amc_install.exe / {app} / Scripts / csfd.cz.ifs < prev    next >
Text File  |  2005-04-11  |  8KB  |  271 lines
  1. (***************************************************
  2.  
  3. Ant Movie Catalog importation script
  4. www.antp.be/software/moviecatalog/
  5.  
  6. [Infos]
  7. Authors=Dmitry501,Inteline,Kalten
  8. Title=csfd.cz
  9. Description=Import dat ze serveru csfd.cz (pouze ΦeskΘ nßzvy film∙)
  10. Site=www.csfd.cz
  11. Language=CZ
  12. Version=1.1
  13. Requires=3.5.0
  14. Comments=
  15. License=This program is free software; you can redistribute it and/or modify it under the  terms of the GNU General Public License as published by the Free Software Foundation;  either version 2 of the License, or (at your option) any later version. |
  16. GetInfo=1
  17.  
  18. [Options]
  19.  
  20. ***************************************************)
  21.  
  22. program Csfd_cz;
  23. const
  24.   BaseAddress = 'http://www.csfd.cz/';
  25. var
  26.   MovieName: string;
  27.  
  28. function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
  29. var
  30.   i: Integer;
  31. begin
  32.   result := -1;
  33.   if StartAt < 0 then
  34.     StartAt := 0;
  35.   for i := StartAt to List.Count-1 do
  36.     if Pos(Pattern, List.GetString(i)) <> 0 then
  37.     begin
  38.       result := i;
  39.       Break;
  40.     end;
  41. end;
  42.  
  43. procedure RozdelStat(Line: string);
  44. var CarkaPos1, CarkaPos2, minPos : Integer;
  45. begin
  46. //rozdeleni statu, roku a delky
  47.     CarkaPos1 := Pos(',', Line);
  48.     if CarkaPos1 > 0 then
  49.     begin
  50.       CarkaPos2 := Pos(',', copy(Line, CarkaPos1+1, length(Line)));
  51.       if CarkaPos2 > 0 then
  52.       begin
  53.         minPos := Pos('min', copy(Line, CarkaPos1+CarkaPos2+1, length(Line)));
  54.         if minPos > 0 then
  55.         begin
  56.           SetField(fieldCountry, trim(copy(Line, 0, CarkaPos1-1)));
  57.           SetField(fieldYear, trim(copy(Line, CarkaPos1+1, CarkaPos2-1)));
  58.           SetField(fieldLength, trim(copy(Line, CarkaPos1+CarkaPos2+1, minPos-1)));
  59.         end
  60.       end
  61.     end
  62. end;
  63.  
  64. function GetDirector(Line: string): String;
  65. var BeginPos : Integer;
  66. begin
  67.     result := '';
  68.     BeginPos := Pos('Re₧ie:', Line);
  69.     if BeginPos > 0 then
  70.     begin
  71.       Delete(Line,1,BeginPos+5);
  72.       BeginPos := Pos('<br>', Line);
  73.       if BeginPos = 0 then BeginPos := Length(Line);
  74.       result := copy(Line, 1, BeginPos);
  75.       HTMLDecode(result);
  76.       HTMLRemoveTags(result);
  77.     end;
  78.   result := Trim(result);
  79. end;
  80.  
  81. function GetActor(Line: string): String;
  82. var BeginPos : Integer;
  83. begin
  84.     result := '';
  85.     BeginPos := Pos('Hrajφ:', Line);
  86.     if BeginPos > 0 then
  87.     begin
  88.       Delete(Line,1,BeginPos + 5);
  89.       BeginPos := Pos('<br>', Line);
  90.       if BeginPos = 0 then BeginPos := Length(Line);
  91.       result := copy(Line, 1, BeginPos);
  92.       HTMLDecode(result);
  93.       HTMLRemoveTags(result);
  94.     end;
  95.   result := Trim(result);
  96. end;
  97.  
  98.  
  99. procedure AnalyzePage(Address: string);
  100. var
  101.   Page: TStringList;
  102.   LineNr : Integer;
  103.   Line, Value : String;
  104.   BeginPos, EndPos : Integer;
  105.   FilmName, FilmAddr, dalsi : String;
  106. begin
  107.     Page := TStringList.Create;
  108.     Page.Text := GetPage(Address);
  109.     LineNr := FindLine('Hledan² v²raz: <b>', Page, 0);
  110.     if LineNr = -1 then
  111.     begin
  112.         AnalyzeMoviePage(Address);
  113.     end
  114.     else
  115.     begin
  116.      LineNr := FindLine('FILMY</td>', Page, 0);
  117.       if LineNr = -1 then
  118.        ShowMessage('No movie found for this search.'+chr(13)+'Nebyly nalezeny zadne zaznamy.')
  119.       else
  120.       begin
  121.         LineNr := FindLine('<a href="film.', Page, 0);
  122.         if LineNr > -1 then
  123.         begin
  124.           PickTreeClear;
  125.           PickTreeAdd('Filmy: ' + MovieName, '');
  126.           Line := Page.GetString(LineNr);
  127.           repeat
  128.             BeginPos := Pos('<a href="film',Line);
  129.             If BeginPos > 0 Then
  130.             begin
  131.               EndPos := Pos('" >',Line);
  132.               if EndPos = 0 Then EndPos := Length(Line);
  133.               FilmAddr := Copy(Line, BeginPos+9, EndPos-BeginPos-9);
  134.               HTMLDecode(FilmAddr);
  135.               HTMLRemoveTags(FilmAddr);
  136.               EndPos := Pos('<br>',Line);
  137.               if EndPos = 0 Then EndPos := Length(Line);
  138.               FilmName := Copy(Line, BeginPos, EndPos-BeginPos);
  139.               HTMLDecode(FilmName);
  140.               HTMLRemoveTags(FilmName);
  141.               dalsi := Copy(FilmName,0,25);
  142.               if dalsi = '...dalÜφ nalezenΘ zßznamy' then
  143.                FilmName := Copy(FilmName,26,Length(FilmName)-25);
  144.               if FilmName <> '' then
  145.                PickTreeAdd(FilmName, BaseAddress + FilmAddr + '&text=1');
  146.               Delete(Line,1,EndPos+3);
  147.             end;
  148.           until BeginPos <1;
  149.          If  PickTreeExec(Address) Then
  150.            AnalyzeMoviePage(Address);
  151.         end;
  152.       end;
  153.     end;
  154. end;
  155.  
  156. procedure AnalyzeMoviePage(Address: string);
  157. var
  158.   Page: TStringList;
  159.   LineNr : Integer;
  160.   Line, Value, Value2 : String;
  161.   LinePos, BeginPos, EndPos, MidPos, PomPos : Integer;
  162. begin
  163.     Page := TStringList.Create;
  164.     Page.Text := GetPage(Address);
  165.     LineNr := FindLine('<span class="style4"', Page, 0);
  166.     if LineNr > -1 then
  167.     begin
  168.       LinePos := 1;
  169.       Line := Page.GetString(LineNr+LinePos);
  170.       //prelozeny nazev
  171.       HTMLDecode(Line);
  172.       HTMLRemoveTags(Line);
  173.       Value := Copy(Trim(Line),4,Length(Trim(Line))-3);
  174.  
  175.       //nazev
  176.       LinePos := LinePos + 1;
  177.       Line := Page.GetString(LineNr+LinePos);
  178.       Value2 := '';
  179.       repeat
  180.         BeginPos := Pos('<table cellpadding=',Line);
  181.         If BeginPos > 0 Then
  182.         begin
  183.           BeginPos := Pos('<td>',Line);
  184.           MidPos := Pos('flag_52.gif',Line);
  185.           Line := Copy(Line,BeginPos+4,Length(Line)-(BeginPos+3));
  186.           EndPos := Pos('</td>',Line);
  187.           if EndPos = 0 Then EndPos := Length(Line);
  188.           if (MidPos < BeginPos) and (MidPos > 0) then
  189.             Value := Value
  190.           else
  191.             Value2 := Value2 + Copy(Line, 1, EndPos) + '/';;
  192.         end;
  193.       until BeginPos < 1;
  194.       SetField(fieldTranslatedTitle, Value);
  195.       if Value2 = '' then
  196.         Value2 := Value
  197.       else
  198.         Value2 := Copy(Value2,1,length(Value2)-2);
  199.       SetField(fieldOriginalTitle, Value2);
  200.  
  201.       //kategorie
  202.       BeginPos := Pos('<b>',Line);
  203.       Line := Copy(Line, BeginPos+3,Length(Line)-(BeginPos-2));
  204.       MidPos := Pos('<br>',Line);
  205.       EndPos := Pos('</b>',Line);
  206.       PomPos := Pos('min</b>',Line);
  207.         //existuji oba radky - kategorie i stat,rok,delka
  208.       if (MidPos < EndPos) and (MidPos > 0) then
  209.       begin
  210.         Value := Trim(Copy(Line, 1, MidPos-7));
  211.         SetField(fieldCategory, Value);
  212.         Value := Trim(Copy(Line, MidPos+4, EndPos-MidPos-4));
  213.         RozdelStat(Value);
  214.       end else
  215.         //existuje jen jeden radek
  216.       if (PomPos < EndPos) and (PomPos > 0) then
  217.       begin
  218.         Value := Trim(Copy(Line, 1, EndPos-1));
  219.         RozdelStat(Value);
  220.       end else
  221.       begin
  222.         Value := Trim(Copy(Line, 1, EndPos-7));
  223.         SetField(fieldCategory,Value);
  224.       end;
  225.      
  226.       Value := GetDirector(Line);
  227.       SetField(fieldDirector, Value);
  228.       Value := GetActor(Line);
  229.       SetField(fieldActors, Value);
  230.     end;
  231.     // picture
  232.     LineNr := FindLine('src="posters/', Page, 0);
  233.     if LineNr > -1 then
  234.     begin
  235.       Line := Page.GetString(LineNr);
  236.       BeginPos := pos('<img src="posters', Line) + 10;
  237.       if BeginPos > 10 then
  238.         begin
  239.           EndPos := pos('" border="', Line);
  240.           Value := copy(Line, BeginPos, EndPos - BeginPos);
  241.           Value := BaseAddress + Value;
  242.           GetPicture(Value);
  243.         end;
  244.     end;
  245.     // Info
  246.     LineNr := FindLine('<B>Obsah/Info:</B>', Page, 0);
  247.     if LineNr > -1 then
  248.     begin
  249.       Value := Page.GetString(LineNr+2);
  250.       HTMLDecode(Value);
  251.       HTMLRemoveTags(Value);
  252.       SetField(fieldDescription, Trim(Value));
  253.     end;
  254.    // URL
  255.    SetField(fieldURL, Address);
  256.   //DisplayResults;
  257. end;
  258.  
  259. begin
  260.   if CheckVersion(3,5,0) then
  261.   begin
  262.     MovieName := GetField(fieldOriginalTitle);
  263.     if MovieName = '' then
  264.       MovieName := GetField(fieldTranslatedTitle);
  265.     if Input('Import movie from www.csfd.cz', 'Enter the title of the movie:', MovieName) then
  266.     begin         AnalyzePage(BaseAddress + 'search.php?search='+UrlEncode(MovieName));
  267.     end;
  268.   end else
  269.   ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
  270. end.
  271.